Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue69/Alfresco/AACpndF.pas

Pascal/Delphi Source File | 2001-04-04 | 32.6 KB | 1,092 lines

{*********************************************************}
{* AACpndF                                               *}
{* Copyright (c) Julian M Bucknall 2001                  *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco: Compound file class              *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AACpndF;

{Notes: a compound file is a file that can contain other subfiles and
        directories. It is a file system of its own. Microsoft name
        this kind of functionality as "structured storage" and there's
        a whole OLE/COM API for it.}

interface

uses
  SysUtils,
  Classes,
  AAIntLst;

type
  TaaHandle = pointer;

  TaaCFDirEntryType = (detUnused, detFolder, detSubfile);

  PaaCFDirEntry = ^TaaCFDirEntry;
  TaaCFDirEntry = packed record     {a directory entry..}
    deName     : string;            {..entry name}
    deType     : TaaCFDirEntryType; {..type of entry}
    de1stBlock : word;              {..first block of data}
    deSize     : longint;           {..size of entry}
    deTime     : TDateTime;         {..timestamp of last update}
    deAttr     : longint;           {..attributes}
  end;

  TaaWalkFolderAction = procedure (var aDirEntry : TaaCFDirEntry;
                                   var aStopWalk : boolean);

  TaaCompoundFile = class
    private
      FCFSize      : integer;
      FFAT         : TaaIntList;
      FFATBlocks   : TaaIntList;
      FHeader      : pointer;
      FOpenFolders : TList;
      FRoot        : TaaHandle;
      FStream      : TFileStream;
    protected
      function cfGetRoot : TaaHandle;

      function cfAddBlock(var aBlock) : integer;
      function cfGetEmptyBlock : integer;
      function cfIsOpenFolder(aParent : TaaHandle;
                        const aName   : string;
                          var aHandle : TaaHandle) : boolean;
      function cfIsValidFolder(aHandle : TaaHandle) : boolean;
      procedure cfPrepare;
      procedure cfReadBlock(aInx : integer; var aBlock);
      procedure cfReadData(aStartInx : integer;
                           aStream   : TStream;
                           aLen      : integer);
      procedure cfReadFAT;
      procedure cfReadHeader;
      procedure cfReleaseChain(aStartInx  : integer;
                               aInclStart : boolean);
      procedure cfSaveFolder(aHandle : TaaHandle);
      procedure cfSaveRootFolder;
      procedure cfWriteBlock(aInx : integer; var aBlock);
      procedure cfWriteData(aStartInx : integer; aStream : TStream);
      procedure cfWriteFAT;
    public
      constructor Create(const aFileName : string; aMode : word);
      destructor Destroy; override;

      {folder methods}
      function AddFolder(aParent : TaaHandle;
                   const aName   : string) : TaaHandle;
      procedure CloseFolder(aHandle : TaaHandle);
      procedure DeleteFolder(aHandle : TaaHandle);
      function OpenFolder(aParent : TaaHandle;
                    const aName   : string) : TaaHandle;
      procedure WalkFolder(aHandle : TaaHandle;
                           aAction : TaaWalkFolderAction);

      {subfile methods}
      procedure DeleteSubfile(aFolder : TaaHandle;
                        const aName   : string);
      procedure ReadSubfile(aFolder : TaaHandle;
                      const aName   : string;
                            aStream : TStream);
      procedure UpdateSubfile(aFolder : TaaHandle;
                        const aName   : string;
                              aStream : TStream);

      property Root : TaaHandle read cfGetRoot;

  end;

  TaaSubfileStream = class(TStream)
    private
      FCF       : TaaCompoundFile;
      FFolder   : TaaHandle;
      FModified : boolean;
      FName     : string;
      FStream   : TMemoryStream;
    protected
    public
      constructor Create(aCF     : TaaCompoundFile;
                         aFolder : TaaHandle;
                   const aName   : string;
                         aCreate : boolean);
      destructor Destroy; override;

      function Read(var Buffer; Count : longint) : longint; override;
      function Write(const Buffer; Count : longint) : longint; override;
      function Seek(Offset : longint; Origin : Word) : longint; override;
  end;

implementation

const
  CFSignature = $46434141;   {AACF: 1st 4 bytes of a compound file}
  CFBlockSize = 512;         {fixed block size}
  CFFATNodeEntryCount = CFBlockSize div sizeof(word);
                             {number of FAT entries per block}
  FATUnusedBlock = $FFFF;    {FAT entry for unused block}
  FATEndOfChain = $FFFE;     {FAT entry for end of FAT chain}

type
  PCFBlock = ^TCFBlock;
  TCFBlock = array [0..pred(CFBlockSize)] of byte;

  PCFHeader = ^TCFHeader;
  TCFHeader = packed record  {header record for compound file..}
    cfhSignature : longint;  {..signature, equals AACF}
    cfhBlockSize : longint;  {..should be 512}
    cfhFATSize   : longint;  {..number of blocks in the FAT}
    cfhRootSize  : longint;  {..size in bytes of the root}
  end;

  PFATNode = ^TFATNode;
  TFATNode = array [0..pred(CFFATNodeEntryCount)] of word;

{====================================================================}
type
  TCFFolder = class
    private
      FCount    : integer;
      FList     : TList;
      FModified : boolean;
      FName     : string;
      FParent   : TaaHandle;
      FRefCount : integer;
    protected
      function cffGetCount : integer;
      function cffGetDirEntry(aInx : integer) : PaaCFDirEntry;
      procedure cffClear;
    public
      constructor Create(aParent : TaaHandle; const aName : string);
      destructor Destroy; override;

      function AddDirEntry(const aName : string;
                                 aType : TaaCFDirEntryType)
                                                      : PaaCFDirEntry;
      procedure RemoveDirEntry(aDE : PaaCFDirEntry);
      function GetDirEntry(const aName : string;
                                 aType : TaaCFDirEntryType)
                                                      : PaaCFDirEntry;
      procedure LoadFromStream(aStrm : TStream);
      procedure SaveToStream(aStrm : TStream);

      procedure MarkModified;

      function DecRefCount : boolean;
      procedure IncRefCount;

      property Count : integer read cffGetCount;
      property DirEntry[aInx : integer] : PaaCFDirEntry
                  read cffGetDirEntry;
      property Modified : boolean read FModified;
      property Name : string read FName;
      property Parent : TaaHandle read FParent;
  end;
{--------}
constructor TCFFolder.Create(aParent : TaaHandle;
                       const aName : string);
begin
  inherited Create;
  FParent := aParent;
  FName := aName;
  FList := TList.Create;
  FRefCount := 1;
end;
{--------}
destructor TCFFolder.Destroy;
begin
  if (FList <> nil) then begin
    cffClear;
    FList.Free;
  end;
  inherited Destroy;
end;
{--------}
function TCFFolder.AddDirEntry(const aName : string;
                                      aType : TaaCFDirEntryType)
                                                      : PaaCFDirEntry;
begin
  Result := AllocMem(sizeof(TaaCFDirEntry));
  Result.deName := aName;
  Result.deType := aType;
  FList.Add(Result);
  MarkModified;
end;
{--------}
procedure TCFFolder.cffClear;
var
  i     : integer;
  Entry : PaaCFDirEntry;
begin
  for i := 0 to pred(FList.Count) do begin
    Entry := FList.List^[i];
    Entry.deName := '';
    Dispose(Entry);
  end;
  FList.Clear;
  FCount := 0;
end;
{--------}
function TCFFolder.cffGetCount : integer;
begin
  Result := FList.Count;
end;
{--------}
function TCFFolder.cffGetDirEntry(aInx : integer) : PaaCFDirEntry;
begin
  Assert((0 <= aInx) and (aInx < Count),
         'TCFFolder.fGetDirEntry: index out of bounds');
  Result := PaaCFDirEntry(FList.List^[aInx]);
end;
{--------}
function TCFFolder.DecRefCount : boolean;
begin
  dec(FRefCount);
  if (FRefCount > 0) then
    Result := false
  else begin
    Result := true;
    Free;
  end;
end;
{--------}
function TCFFolder.GetDirEntry(const aName : string;
                                     aType : TaaCFDirEntryType)
                                                      : PaaCFDirEntry;
var
  i : integer;
begin
  for i := 0 to pred(FList.Count) do begin
    Result := PaaCFDirEntry(FList.List^[i]);
    if (Result^.deType = aType) and (Result^.deName = aName) then
      Exit;
  end;
  Result := nil;
end;
{--------}
procedure TCFFolder.IncRefCount;
begin
  inc(FRefCount);
end;
{--------}
procedure TCFFolder.LoadFromStream(aStrm : TStream);
var
  i       : integer;
  Entry   : PaaCFDirEntry;
  NameLen : byte;
  CountInStrm : longint;
begin
  aStrm.Seek(0, soFromBeginning);
  cffClear;
  aStrm.ReadBuffer(CountInStrm, sizeof(longint));
  for i := 0 to pred(CountInStrm) do begin
    New(Entry);
    with Entry^ do begin
      aStrm.ReadBuffer(NameLen, sizeof(NameLen));
      SetLength(deName, NameLen);
      aStrm.ReadBuffer(deName[1], NameLen);
      aStrm.ReadBuffer(deType, sizeof(deType));
      aStrm.ReadBuffer(de1stBlock, sizeof(de1stBlock));
      aStrm.ReadBuffer(deSize, sizeof(deSize));
      aStrm.ReadBuffer(deTime, sizeof(deTime));
      aStrm.ReadBuffer(deAttr, sizeof(deAttr));
    end;
    FList.Add(Entry);
  end;
end;
{--------}
procedure TCFFolder.MarkModified;
begin
  FModified := true;
end;
{--------}
procedure TCFFolder.RemoveDirEntry(aDE : PaaCFDirEntry);
begin
  Dispose(aDE);
  FList.Remove(aDE);
  MarkModified;
end;
{--------}
procedure TCFFolder.SaveToStream(aStrm : TStream);
var
  i       : integer;
  Entry   : PaaCFDirEntry;
  NameLen : byte;
  CountInStrm : longint;
begin
  aStrm.Seek(0, soFromBeginning);
  CountInStrm := Count;
  aStrm.WriteBuffer(CountInStrm, sizeof(longint));
  for i := 0 to pred(Count) do begin
    Entry := PaaCFDirEntry(FList.List^[i]);
    with Entry^ do begin
      NameLen := length(deName);
      aStrm.WriteBuffer(NameLen, sizeof(NameLen));
      aStrm.WriteBuffer(deName[1], NameLen);
      aStrm.WriteBuffer(deType, sizeof(deType));
      aStrm.WriteBuffer(de1stBlock, sizeof(de1stBlock));
      aStrm.WriteBuffer(deSize, sizeof(deSize));
      aStrm.WriteBuffer(deTime, sizeof(deTime));
      aStrm.WriteBuffer(deAttr, sizeof(deAttr));
    end;
  end;
end;
{====================================================================}


{===TaaCompoundFile==================================================}
constructor TaaCompoundFile.Create(const aFileName : string; aMode : word);
begin
  {create the ancestor}
  inherited Create;

  {open the file stream}
  FStream := TFileStream.Create(aFileName, aMode);

  {create the in-memory FAT}
  FFAT := TaaIntList.Create;
  FFATBlocks := TaaIntList.Create;

  {allocate the header}
  GetMem(FHeader, CFBlockSize);

  {allocate the list of open folders}
  FOpenFolders := TList.Create;

  {if the stream is new (size is zero) write the header record}
  if (FStream.Size = 0) then
    cfPrepare
  {otherwise read the header and make sure that it's one of our files}
  else
    cfReadHeader;
end;
{--------}
destructor TaaCompoundFile.Destroy;
var
  i : integer;
  Folder : TCFFolder;
begin
  {destroy the open folders}
  if (FOpenFolders <> nil) then begin
    for i := pred(FOpenFolders.Count) downto 0 do begin
      Folder := TCFFolder(FOpenFolders.List^[i]);
      CloseFolder(Folder);
    end;
    FOpenFolders.Free;
  end;

  {destroy the root if it was opened}
  cfSaveRootFolder;
  TCFFolder(FRoot).Free;

  {destroy the FAT}
  cfWriteFAT;
  FFATBlocks.Free;
  FFAT.Free;

  {free the header block}
  if (FHeader <> nil) then begin
    cfWriteBlock(0, FHeader^);
    FreeMem(FHeader, CFBlockSize);
  end;

  {close the stream}
  FStream.Free;

  {destroy the ancestor}
  inherited Destroy;
end;
{--------}
function TaaCompoundFile.AddFolder(aParent : TaaHandle;
                             const aName   : string) : TaaHandle;
var
  DE     : PaaCFDirEntry;
  Folder : TCFFolder;
begin
  {check that the parent is a valid folder}
  if not cfIsValidFolder(aParent) then
    raise Exception.Create(
          'TaaCompoundFile.AddFolder: parent is not valid handle');

  {get the directory entry of the folder; if we succeed then the
   folder already exists--an error}
  DE := TCFFolder(aParent).GetDirEntry(aName, detFolder);
  if (DE <> nil) then
    raise Exception.Create(
          'TaaCompoundFile.AddFolder: name already exists as valid folder');

  {create the folder}
  Folder := TCFFolder.Create(aParent, aName);
  Folder.MarkModified;

  {add the folder name to the parent's directory list}
  TCFFolder(aParent).AddDirEntry(aName, detFolder);
  TCFFolder(aParent).IncRefCount;

  {add the folder to the open folders list, return the folder}
  FOpenFolders.Add(Folder);
  Result := TaaHandle(Folder);
end;
{--------}
function TaaCompoundFile.cfAddBlock(var aBlock) : integer;
begin
  Result := FCFSize div CFBlockSize;
  cfWriteBlock(Result, aBlock);
end;
{--------}
function TaaCompoundFile.cfGetEmptyBlock : integer;
var
  i, j    : integer;
  FATInx  : integer;
  FATNode : TFATNode;
begin
  {walk the FAT looking for an unused FAT entries}
  i := 0;
  while (i < FFAT.Count) and (FFAT[i] <> FATUnusedBlock) do
    inc(i);
  {if there were no unused FAT entries..}
  if (i >= FFAT.Count) then begin
    {we need to add another FAT node to the compound file}
    FillChar(FATNode, CFBlockSize, $FF);
    FATInx := cfAddBlock(FATNode);
    FFAT.Capacity := FFAT.Capacity + CFFATNodeEntryCount;
    for j := 0 to pred(CFFATNodeEntryCount) do
      FFAT.Add(FATUnusedBlock);
    FFAT[FFATBlocks.Last] := FATInx;
    FFAT[FATInx] := FATEndOfChain;
    FFATBlocks.Add(FATInx);
    inc(PCFHeader(FHeader)^.cfhFATSize);
    {we'll use the first unused FAT entry}
    i := FFAT.Count - CFFATNodeEntryCount + 1;
  end;
  FFAT[i] := FATEndOfChain;
  Result := i;
end;
{--------}
function TaaCompoundFile.cfGetRoot : TaaHandle;
var
  Strm : TMemoryStream;
  WorkRoot : TCFFolder;
begin
  if (FRoot = nil) then begin
    WorkRoot := TCFFolder.Create(nil, '');
    try
      if (PCFHeader(FHeader)^.cfhRootSize <> 0) then begin
        Strm := TMemoryStream.Create;
        try
          cfReadData(2, Strm, PCFHeader(FHeader)^.cfhRootSize);
          WorkRoot.LoadFromStream(Strm);
        finally
          Strm.Free;
        end;
      end;
    except
      WorkRoot.Free;
      raise;
    end;
    FRoot := WorkRoot;
  end;
  Result := FRoot;
end;
{--------}
function TaaCompoundFile.cfIsOpenFolder(aParent : TaaHandle;
                                  const aName   : string;
                                    var aHandle : TaaHandle) : boolean;
var
  i : integer;
  Folder : TCFFolder;
begin
  Assert(aParent <> nil,
         'TaaCompoundFile.cfIsOpenFolder: should not be called with nil parent');
  Result := false;
  for i := 0 to pred(FOpenFolders.Count) do begin
    Folder := TCFFolder(FOpenFolders.List^[i]);
    if (Folder.Parent = aParent) and (Folder.Name = aName) then begin
      Result := true;
      aHandle := TaaHandle(Folder);
      Exit;
    end;
  end;
end;
{--------}
function TaaCompoundFile.cfIsValidFolder(aHandle : TaaHandle) : boolean;
var
  i : integer;
begin
  if (aHandle = nil) then
    Result := false
  else if (aHandle = FRoot) then
    Result := true
  else begin
    Result := false;
    for i := 0 to pred(FOpenFolders.Count) do
      if (aHandle = FOpenFolders.List^[i]) then begin
        Result := true;
        Break;
      end;
  end;
end;
{--------}
procedure TaaCompoundFile.cfPrepare;
var
  Header  : PCFHeader;
  FATNode : TFATNode;
  RootDir : TCFBlock;
begin
  {initialize the header (this will block 0)}
  Header := FHeader;
  FillChar(Header^, CFBlockSize, 0);
  Header^.cfhSignature := CFSignature;
  Header^.cfhBlockSize := 512;
  Header^.cfhFATSize := 1;
  {write out the header}
  cfAddBlock(Header^);
  {initialize the first FAT node (most entries are "unused")}
  FillChar(FATNode, sizeof(FATNode), $FF);
  FATNode[0] := FATEndOfChain;
  FATNode[1] := FATEndOfChain;
  FATNode[2] := FATEndOfChain;
  {write out the first FAT node; set up the in-memory FAT}
  cfAddBlock(FATNode);
  cfReadFAT;
  {initialize the root directory}
  FillChar(RootDir, sizeof(RootDir), 0);
  {write out the root directory}
  cfAddBlock(RootDir);
end;
{--------}
procedure TaaCompoundFile.cfReadBlock(aInx : integer; var aBlock);
var
  Offset : integer;
begin
  Offset := aInx * CFBlockSize;
  Assert((0 <= Offset) and (Offset < FCFSize),
         'TaaCompoundFile.cfReadBlock: Offset to read is out of range');
  FStream.Seek(aInx * CFBlockSize, soFromBeginning);
  FStream.ReadBuffer(aBlock, CFBlockSize);
end;
{--------}
procedure TaaCompoundFile.cfReadData(aStartInx : integer;
                                     aStream   : TStream;
                                     aLen      : integer);
var
  Inx       : integer;
  DataBlock : TCFBlock;
  BytesToCopy : integer;
begin
  Assert(aLen <> 0,
         'TaaCompoundFile.cfReadData: length of data is zero');
  {position the stream at the start}
  aStream.Seek(0, soFromBeginning);
  {start at the first block}
  Inx := aStartInx;
  while (Inx <> FATEndOfChain) do begin
    Assert(aLen <> 0,
         'TaaCompoundFile.cfReadData: more data present than length indicates');
    {read the current block}
    cfReadBlock(Inx, DataBlock);
    {write it to the stream}
    if (aLen < CFBlockSize) then
      BytesToCopy := aLen
    else
      BytesToCopy := CFBlockSize;
    aStream.WriteBuffer(DataBlock, BytesToCopy);
    dec(aLen, BytesToCopy);
    {advance along to the next block}
    Inx := FFAT[Inx];
    Assert(Inx <> FATUnusedBlock,
           'TaaCompoundFile.cfReadDir: unused block in FAT chain');
  end;
  Assert(aLen = 0,
         'TaaCompoundFile.cfReadData: less data present than length indicates');
end;
{--------}
procedure TaaCompoundFile.cfReadFAT;
var
  i       : integer;
  Header  : PCFHeader;
  FATNode : TFATNode;
  FATInx  : integer;
begin
  {prepare the in-memory FAT}
  Header := FHeader;
  FFAT.Clear;
  FFAT.Capacity := Header^.cfhFATSize * CFFATNodeEntryCount;
  FFAT.IsSorted := false;
  FFATBlocks.Clear;
  FFAT.Capacity := Header^.cfhFATSize;
  FFAT.IsSorted := false;
  {the FAT starts at block 1}
  FATInx := 1;
  {read the FAT blocks}
  while (FATInx <> FATEndOfChain) do begin
    FFATBlocks.Add(FATInx);
    cfReadBlock(FATInx, FATNode);
    for i := 0 to pred(CFFATNodeEntryCount) do
      FFAT.Add(FATNode[i]);
    FATInx := FFAT[FATInx];
    Assert(FATInx <> FATUnusedBlock,
           'TaaCompoundFile.cfReadFAT: unused block in FAT chain');
  end;
end;
{--------}
procedure TaaCompoundFile.cfReadHeader;
var
  Header : PCFHeader;
begin
  {first test: check the stream size}
  FCFSize := FStream.Size;
  if (FCFSize < 3 * CFBlockSize) or
     (((FCFSize div CFBlockSize) * CFBlockSize) <> FCFSize) then
    raise Exception.Create('Stream is not a compound file: wrong size');

  {second test: check the first block is a compound file header}
  Header := FHeader;
  cfReadBlock(0, Header^);
  if (Header^.cfhSignature <> CFSignature) or
     (Header^.cfhBlockSize <> 512) or
     (Header^.cfhFATSize <= 0) then
    raise Exception.Create('Stream is not a compound file: header invalid');

  {now read the FAT}
  cfReadFAT;
end;
{--------}
procedure TaaCompoundFile.cfReleaseChain(aStartInx  : integer;
                                         aInclStart : boolean);
var
  Inx     : integer;
  NextInx : integer;
begin
  {depending on the user's request, begin at the start block or the
   next one in the FAT chain}
  if aInclStart then
    Inx := aStartInx
  else
    Inx := FFAT[aStartInx];
  {while we haven't reached the end of the chain}
  while (Inx <> FATEndOfChain) do begin
    {free this block}
    NextInx := FFAT[Inx];
    FFAT[Inx] := FATUnusedBlock;
    Inx := NextInx;
  end;
end;
{--------}
procedure TaaCompoundFile.cfSaveFolder(aHandle : TaaHandle);
var
  Parent : TCFFolder;
  Folder : TCFFolder;
  DE     : PaaCFDirEntry;
  Strm   : TMemoryStream;
begin
  {get the folder from the handle}
  Folder := TCFFolder(aHandle);
  {if the folder was modified...}
  if Folder.Modified then begin
    {get the parent handle}
    Parent := TCFFolder(Folder.Parent);
    {get the directory entry in the parent for this folder}
    DE := Parent.GetDirEntry(Folder.Name, detFolder);
    Assert(DE <> nil,
           'TaaCompoundFile.cfSaveFolder: parent dir entry not found');
    {if the folder is empty...}
    if (Folder.Count = 0) then begin
      {make sure it uses no blocks}
      if (DE^.de1stBlock <> 0) then begin
        cfReleaseChain(DE^.de1stBlock, true);
        DE^.de1stBlock := 0;
      end;
      {update the parent}
      DE^.deSize := 0;
      DE^.deTime := Now;
      Parent.MarkModified;
    end
    {otherwise the folder has directory entries}
    else begin
      {if this folder has never been written, get the first block}
      if (DE^.de1stBlock = 0) then
        DE^.de1stBlock := cfGetEmptyBlock;
      {copy the folder data to a stream, and from thence to the
       compound file}
      Strm := TMemoryStream.Create;
      try
        {save the folder to the stream}
        Folder.SaveToStream(Strm);
        {save the stream to the compound file}
        cfWriteData(DE^.de1stBlock, Strm);
        {update the parent}
        DE^.deSize := Strm.Size;
        DE^.deTime := Now;
        Parent.MarkModified;
      finally
        Strm.Free;
      end;
    end;
  end;
end;
{--------}
procedure TaaCompoundFile.cfSaveRootFolder;
var
  Folder : TCFFolder;
  Strm   : TMemoryStream;
begin
  {get the root folder}
  Folder := TCFFolder(FRoot);
  {if the folder was modified...}
  if (Folder <> nil) and Folder.Modified then begin
    {copy the folder data to a stream, and from thence to the
     compound file}
    Strm := TMemoryStream.Create;
    try
      {save the folder to the stream}
      Folder.SaveToStream(Strm);
      {save the stream to the compound file}
      cfWriteData(2, Strm);
      {update the header}
      PCFHeader(FHeader).cfhRootSize := Strm.Size;
    finally
      Strm.Free;
    end;
  end;
end;
{--------}
procedure TaaCompoundFile.cfWriteBlock(aInx : integer; var aBlock);
var
  Offset : integer;
begin
  Offset := aInx * CFBlockSize;
  Assert((0 <= Offset) and (Offset <= FCFSize),
         'TaaCompoundFile.cfWriteBlock: Offset to write is out of range');
  FStream.Seek(Offset, soFromBeginning);
  FStream.WriteBuffer(aBlock, CFBlockSize);
  if (Offset = FCFSize) then
    FCFSize := Offset + CFBlockSize;
end;
{--------}
procedure TaaCompoundFile.cfWriteData(aStartInx : integer;
                                      aStream   : TStream);
var
  Inx       : integer;
  NewInx    : integer;
  DataBlock : TCFBlock;
  BytesToGo : integer;
  BytesTOCopy : integer;
begin
  {position the stream at the start}
  aStream.Seek(0, soFromBeginning);
  {start at the first block}
  Inx := aStartInx;
  {release all subsequent blocks}
  cfReleaseChain(aStartInx, false);

  {calculate the number of bytes to write to the first block
   (we don't have to allocate this one: it's already done)}
  BytesToGo := aStream.Size;
  if (BytesToGo > CFBlockSize) then
    BytesToCopy := CFBlockSize
  else begin
    FillChar(DataBlock, sizeof(DataBlock), $CC);
    BytesToCopy := BytesToGo;
  end;
  dec(BytesToGo, BytesToCopy);
  {copy the data over for the first block}
  aStream.ReadBuffer(DataBlock, BytesToCopy);
  cfWriteBlock(Inx, DataBlock);

  {while there is still more data to write...}
  while (BytesToGo <> 0) do begin
  {calculate the number of bytes to write to the next block}
    if (BytesToGo > CFBlockSize) then
      BytesToCopy := CFBlockSize
    else begin
      FillChar(DataBlock, sizeof(DataBlock), $CC);
      BytesToCopy := BytesToGo;
    end;
    dec(BytesToGo, BytesToCopy);
    {allocate another block from the compound file}
    NewInx := cfGetEmptyBlock;
    FFAT[Inx] := NewInx;
    Inx := NewInx;
    {copy the data over}
    aStream.ReadBuffer(DataBlock, BytesToCopy);
    cfWriteBlock(Inx, DataBlock);
  end;
end;
{--------}
procedure TaaCompoundFile.cfWriteFAT;
var
  i, j    : integer;
  FATNode : TFATNode;
  BlockInx: integer;
begin
  Assert(FFATBlocks.Count * CFFATNodeEntryCount = FFAT.count,
         'TaaCompoundFile.cfWriteFAT: invalid number of FAT entries');
  i := 0;
  for BlockInx := 0 to pred(FFATBlocks.Count) do begin
    for j := 0 to pred(CFFATNodeEntryCount) do begin
      FATNode[j] := FFAT[i];
      inc(i);
    end;
    cfWriteBlock(FFATBlocks[BlockInx], FATNode);
  end;
end;
{--------}
procedure TaaCompoundFile.CloseFolder(aHandle : TaaHandle);
var
  i      : integer;
  Folder : TCFFolder;
  Parent : TCFFolder;
begin
  {Note: once opened, the root folder is never closed}

  {if the handle is not nil, nor the root...}
  if (aHandle <> nil) and (aHandle <> FRoot) then
    {find the folder in the open folders list...}
    for i := 0 to pred(FOpenFolders.Count) do begin
      Folder := TCFFolder(FOpenFolders.List^[i]);
      {if the current item is the passed handle...}
      if (aHandle = Folder) then begin
        {get the parent}
        Parent := TCFFolder(Folder.Parent);
        {decrement the reference count for the open folder}
        cfSaveFolder(Folder);
        if Folder.DecRefCount then
          FOpenFolders.Delete(i);
        {decrement the reference count for the parent}
        if (Parent <> FRoot) then begin
          cfSaveFolder(Parent);
          if Parent.DecRefCount then
            FOpenFolders.Remove(Parent);
        end;
        Exit;
      end;
    end;
end;
{--------}
procedure TaaCompoundFile.DeleteFolder(aHandle : TaaHandle);
begin
  Assert(false, 'TaaCompoundFile.DeleteFolder not implemented yet');
end;
{--------}
procedure TaaCompoundFile.DeleteSubfile(aFolder : TaaHandle;
                                  const aName   : string);
var
  DE : PaaCFDirEntry;
  Folder   : TCFFolder;
begin
  {check that the folder is valid}
  if not cfIsValidFolder(aFolder) then
    raise Exception.Create(
          'TaaCompoundFile.DeleteSubfile: parent is not valid handle');

  {get the directory entry of the subfile}
  Folder := TCFFolder(aFolder);
  DE := Folder.GetDirEntry(aName, detSubfile);

  {if the directory entry exists...}
  if (DE <> nil) then begin
    {free all the blocks occupied by the subfile}
    if (DE^.de1stBlock <> 0) then
      cfReleaseChain(DE^.de1stBlock, true);
    {remove the directory entry}
    Folder.RemoveDirEntry(DE);
  end;
end;
{--------}
function TaaCompoundFile.OpenFolder(aParent : TaaHandle;
                              const aName   : string) : TaaHandle;
var
  DE     : PaaCFDirEntry;
  Strm   : TMemoryStream;
  Folder : TCFFolder;
  Handle : TaaHandle;
begin
  {check that the parent is a valid folder}
  if not cfIsValidFolder(aParent) then
    raise Exception.Create(
          'TaaCompoundFile.OpenFolder: parent is not valid handle');

  {get the directory entry of the folder; if this fails, the folder
   name doesn't exist in the parent}
  DE := TCFFolder(aParent).GetDirEntry(aName, detFolder);
  if (DE = nil) then
    raise Exception.Create(
          'TaaCompoundFile.OpenFolder: name is not valid folder');

  {check to see if the folder hasn't already been opened; in which
   case just increment the reference counts, return the open handle
   and exit}
  if cfIsOpenFolder(aParent, aName, Handle) then begin
    TCFFolder(aParent).IncRefCount;
    TCFFolder(Handle).IncRefCount;
    Result := Handle;
    Exit;
  end;

  {create and read the folder}
  Folder := TCFFolder.Create(aParent, aName);
  try
    if (DE^.deSize <> 0) then begin
      Strm := TMemoryStream.Create;
      try
        cfReadData(DE^.de1stBlock, Strm, DE^.deSize);
        Folder.LoadFromStream(Strm);
      finally
        Strm.Free;
      end;
    end;
  except
    Folder.Free;
    raise;
  end;

  {increment the reference count for the parent
   (note: the folder has just been created so we don't update its
          reference count)}
  TCFFolder(aParent).IncRefCount;

  {add the folder to the open folders list, return the folder}
  FOpenFolders.Add(Folder);
  Result := TaaHandle(Folder);
end;
{--------}
procedure TaaCompoundFile.ReadSubfile(aFolder : TaaHandle;
                                const aName   : string;
                                      aStream : TStream);
var
  DE : PaaCFDirEntry;
begin
  {check that the folder is valid}
  if not cfIsValidFolder(aFolder) then
    raise Exception.Create(
          'TaaCompoundFile.ReadSubfile: parent is not valid handle');

  {get the directory entry of the subfile; if this fails, the subfile
   name doesn't exist in the folder}
  DE := TCFFolder(aFolder).GetDirEntry(aName, detSubfile);
  if (DE = nil) then
    raise Exception.Create(
          'TaaCompoundFile.ReadSubfile: name is not valid subfile');

  {if there's some data, copy it to the stream}
  aStream.Seek(0, soFromBeginning);
  if (DE^.deSize <> 0) then
    cfReadData(DE^.de1stBlock, aStream, DE^.deSize);
  aStream.Size := DE^.deSize;
end;
{--------}
procedure TaaCompoundFile.UpdateSubfile(aFolder : TaaHandle;
                                  const aName   : string;
                                        aStream : TStream);
var
  DE : PaaCFDirEntry;
  StrmSize : integer;
  Folder   : TCFFolder;
begin
  {check that the folder is valid}
  if not cfIsValidFolder(aFolder) then
    raise Exception.Create(
          'TaaCompoundFile.UpdateSubfile: parent is not valid handle');

  {get the directory entry of the subfile}
  Folder := TCFFolder(aFolder);
  DE := Folder.GetDirEntry(aName, detSubfile);

  {if the directory entry doesn't exist, create a new one}
  if (DE = nil) then
    DE := Folder.AddDirEntry(aName, detSubfile);

  {if the stream is empty, make sure the existing blocks are freed}
  StrmSize := aStream.Size;
  if (StrmSize = 0) then begin
    if (DE^.de1stBlock <> 0) then begin
      cfReleaseChain(DE^.de1stBlock, true);
      DE^.de1stBlock := 0;
    end;
  end
  {otherwise there's some data to write}
  else begin
    {if this subfile has never been written, get the first block}
    if (DE^.de1stBlock = 0) then
      DE^.de1stBlock := cfGetEmptyBlock;
    {save the stream to the compound file}
    cfWriteData(DE^.de1stBlock, aStream);
  end;
  {update the folder}
  DE^.deSize := StrmSize;
  DE^.deTime := Now;
  Folder.MarkModified;
end;
{--------}
procedure TaaCompoundFile.WalkFolder(aHandle : TaaHandle;
                                     aAction : TaaWalkFolderAction);
var
  i : integer;
  StopNow : boolean;
  Folder  : TCFFolder;
begin
  if not cfIsValidFolder(aHandle) then
    raise Exception.Create(
          'TaaCompoundFile.WalkFolder: invalid folder handle');

  StopNow := false;
  Folder := TCFFolder(aHandle);
  for i := 0 to pred(Folder.Count) do begin
    aAction(Folder.DirEntry[i]^, StopNow);
    if StopNow then
      Break;
  end;
end;
{====================================================================}


{===TaaSubfileStream=================================================}
constructor TaaSubfileStream.Create(aCF     : TaaCompoundFile;
                                    aFolder : TaaHandle;
                              const aName   : string;
                                    aCreate : boolean);
begin
  inherited Create;
  FCF := aCF;
  FFolder := aFolder;
  FName := aName;
  FStream := TMemoryStream.Create;
  if aCreate then
    aCF.DeleteSubfile(aFolder, aName)
  else
    aCF.ReadSubFile(aFolder, aName, FStream);
end;
{--------}
destructor TaaSubfileStream.Destroy;
begin
  if FModified then
    FCF.UpdateSubfile(FFolder, FName, FStream);
  FStream.Free;
  inherited Destroy;
end;
{--------}
function TaaSubfileStream.Read(var Buffer; Count : longint) : longint;
begin
  Result := FStream.Read(Buffer, Count);
end;
{--------}
function TaaSubfileStream.Write(const Buffer; Count : longint) : longint;
begin
  Result := FStream.Write(Buffer, Count);
  FModified := true;
end;
{--------}
function TaaSubfileStream.Seek(Offset : longint; Origin : Word) : longint;
begin
  Result := FStream.Seek(Offset, Origin);
end;
{====================================================================}

end.